Shareware Grab Bag/Shareware Grab Bag.iso/010/dunquest.arc/DUNSHOP.BAS

BASIC Source File | 1985-10-30 | 11.6 KB | 292 lines

10 'DUNSHOP  THE SUPPLY SHOPPE - EQUIP CHARACTERS
20   SCREEN 3
30   KEY OFF
40      WIDTH 20
50      COLOR 1,4
60      CLS
70      LOCATE 4,1
80      PRINT "       THE"
90      LOCATE 7,1
100     PRINT "      SUPPLY"
110     LOCATE 10,1
120     PRINT "      SHOPPE"
130 'KILL TIME
140     SV.TIMER = TIMER+5
150     GOSUB 490 'OPEN FILES
160     IF TIMER < SV.TIMER THEN GOTO 160
170 'PRINT MENU
180     SCREEN 1
190     WIDTH 40
200     COLOR 4,1
210     CLS
220     LOCATE 3,1
230     PRINT "           THE SUPPLY SHOPPE"
240     PRINT
250     PRINT "    1. BUY SUPPLIES"
260     PRINT
270     PRINT "    2. SELL SUPPLIES"
280     PRINT
290     PRINT "    3. ADD A NEW ITEM TO THE STORE"
300     PRINT
310     PRINT "    4. CHANGE AN ITEM IN THE STORE"
320     PRINT
330     PRINT "    5. LIST SUPPLIES"
340     PRINT
350     PRINT "    9. END"
360     GOSUB 440 'GET REPLY
370     IF REPLY$ = "1" THEN GOSUB 590:  GOTO 170
380     IF REPLY$ = "2" THEN GOSUB 1150: GOTO 170
390      IF REPLY$ = "3" THEN GOSUB 1740: GOTO 170
400      IF REPLY$ = "4" THEN GOSUB 2380: GOTO 170
410     IF REPLY$ = "5" THEN GOSUB 2780: GOTO 170
420     IF REPLY$ ="9" THEN GOTO 2220
430     GOTO 170
440 'GET REPLY
450     DEF SEG=0: POKE 1050,PEEK(1052) 'CLEAR KEYBOARD BUFFER
460     REPLY$ = INKEY$
470     IF REPLY$ = "" THEN GOTO 460
480 RETURN
490 'OPEN FILES
500     OPEN "DUNCHAR" AS #1 LEN=122
510     FIELD #1,2 AS STRN$,2 AS INTL$,2 AS WIS$,2 AS DEX$,2 AS CON$,2 AS CHA$, 10 AS CLAS$,2 AS HIT$,4 AS MONEY$,2 AS LVL$,2 AS ARM$,2 AS SV.POISON$,2 AS SV.MAGIC$,2 AS SV.STONE$,2 AS SV.DRAG$,2 AS SV.SPELL$,4 AS EXPR$,24 AS NM$,7 AS ALIGN$,45 AS D$
520     OPEN "DUNSHOP" AS #2 LEN=44
530     FIELD #2,2 AS SID$,1 AS SCLASS$,15 AS SNAME$,2 AS SCOST$,2 AS SDAM$,2 AS SWT$,2 AS P1$,2 AS P2$,2 AS P3$,2 AS P4$,2 AS P5$,2 AS P6$,2 AS P7$,2 AS P8$,2 AS P9$,2 AS P10$
540 '
550 '    DAMAGE IS ARMOR CLASS FOR ARMOR, CHARACTER TYPE FOR SPELLS
560 '    WEIGHT IS LEVEL FOR SPELLS
570 '
580 RETURN
590 'BUY SUPPLIES
600     GOSUB 2260 'GET PLAYER
610     CLS: PRINT "          BUY SUPPLIES"
620    PRINT "YOU HAVE";CVS(MONEY$);"GOLD PIECES"
630     LOCATE 25,1: PRINT "TO BUY ENTER HOW MANY,TO SKIP HIT SPACE";:LOCATE 2,1
640     LET SNO=0
650 'GO THRU FILE
660     SNO=SNO+1
670     GET #2,SNO
680     IF SID$ <> "DS" THEN GOTO 1120
690    IF LEFT$(SNAME$,5)="CURSE" OR LEFT$(SNAME$,5)="MAGIC" THEN GOTO 650
700     IF CLAS$="CLERIC    " AND (SNO=5 OR SNO=8 OR SNO=9 OR SNO=10 OR SNO=11)            GOTO 650
710     IF SCLASS$ <> "S" THEN GOTO 870
720     ON RNO GOTO 730,740,750,760,770,780,790,800,810,820
730      SQUAN = CVI(P1$): GOTO 830
740      SQUAN = CVI(P2$): GOTO 830
750      SQUAN = CVI(P3$): GOTO 830
760      SQUAN = CVI(P4$): GOTO 830
770      SQUAN = CVI(P5$): GOTO 830
780      SQUAN = CVI(P6$): GOTO 830
790      SQUAN = CVI(P7$): GOTO 830
800      SQUAN = CVI(P8$): GOTO 830
810      SQUAN = CVI(P9$): GOTO 830
820      SQUAN = CVI(P10)$): GOTO 830
830     IF CLAS$="CLERIC    " AND CVI(SDAM$) = 1 THEN GOTO 860
840    IF CVI(SDAM$) <> 3 THEN GOTO 650
850     IF CLAS$="ELF       " OR CLAS$="MAGIC-USER" THEN GOTO 860                         ELSE GOTO 650
860     IF CVI(SWT$) > CVI(LVL$) THEN GOTO 650
870     PRINT SNAME$;"COST";CVI(SCOST$);"WEIGHT";CVI(SWT$)
880     GOSUB 440
890     IF REPLY$ = " " THEN GOTO 650
900    QUAN=VAL(REPLY$)
910     IF QUAN=0 THEN GOTO 650
920     IF SCLASS$ <> "S" THEN GOTO 950
930    MAX.SPELLS = (CVI(LVL$)-CVI(SWT$))+1
940    IF (QUAN+SQUAN) > MAX.SPELLS THEN PRINT "YOU CAN ONLY GET ";MAX.SPELLS-SQUAN: GOTO 880
950     PRICE = QUAN * CVI(SCOST$)
960     IF PRICE > CVS(MONEY$) THEN PRINT "YOU CAN'T AFFORD ";QUAN:                       PRINT "YOU HAVE ";CVS(MONEY$)";GOLD PIECES":  GOTO 880
970     LSET MONEY$ = MKS$(CVS(MONEY$) - PRICE)
980    PRINT "YOU HAVE ";CVS(MONEY$);"GOLD PIECES"
990     ON RNO GOTO 1000,1010,1020,1030,1040,1050,1060,1070,1080,1090
1000     LSET P1$ = MKI$(QUAN + CVI(P1$)): GOTO 1100
1010      LSET P2$ = MKI$(QUAN + CVI(P2$)): GOTO 1100
1020      LSET P3$ = MKI$(QUAN + CVI(P3$)): GOTO 1100
1030      LSET P4$ = MKI$(QUAN + CVI(P4$)): GOTO 1100
1040      LSET P5$ = MKI$(QUAN + CVI(P5$)): GOTO 1100
1050      LSET P6$ = MKI$(QUAN + CVI(P6$)): GOTO 1100
1060      LSET P7$ = MKI$(QUAN + CVI(P7$)): GOTO 1100
1070      LSET P8$ = MKI$(QUAN + CVI(P8$)): GOTO 1100
1080      LSET P9$ = MKI$(QUAN + CVI(P9$)): GOTO 1100
1090      LSET P10$ = MKI$(QUAN + CVI(P10$)): GOTO 1100
1100     PUT #2,SNO
1110     GOTO 650
1120 'END OF SHOPPING
1130     PUT #1,RNO
1140 RETURN
1150 'SELL SUPPLIES
1160     GOSUB 2260
1170     CLS: PRINT "          SELL SUPPLIES"
1180     LOCATE 25,1: PRINT "TO SELL ENTER HOW MANY, SPACE TO SKIP";: LOCATE 2,1
1190     LET SNO=0
1200 'GO THRU FILE
1210     SNO=SNO+1
1220     GET #2,SNO
1230     IF SID$ <> "DS" THEN GOTO 1680 'END OF FILE
1240     ON RNO GOTO 1250,1260,1270,1280,1290,1300,1310,1320,1330,1340
1250     QUAN = CVI(P1$): GOTO 1350
1260     QUAN = CVI(P2$): GOTO 1350
1270      QUAN = CVI(P3$): GOTO 1350
1280      QUAN = CVI(P4$): GOTO 1350
1290      QUAN = CVI(P5$): GOTO 1350
1300      QUAN = CVI(P6$): GOTO 1350
1310      QUAN = CVI(P7$): GOTO 1350
1320      QUAN = CVI(P8$): GOTO 1350
1330      QUAN = CVI(P9$): GOTO 1350
1340      QUAN = CVI(P10)$): GOTO 1350
1350    IF QUAN=0 THEN GOTO 1200
1360    PRINT "YOU HAVE";QUAN;SNAME$;"COST";CVI(SCOST$);
1370    GOSUB 440
1380    IF (VAL(REPLY$) > 0) AND (LEFT$(SNAME$,5)="CURSE") THEN PRINT "DON'T YOU WISH": GOTO 1360
1390    IF VAL(REPLY$) => QUAN THEN GOTO 1480
1400    IF CLAS$="CLERIC    " AND (SNO=5 OR SNO=8 OR SNO=9 OR SNO=10 OR SNO=11            OR SNO=34) THEN PRINT "CLERICS CAN'T USED EDGED WEAPONS": GOTO 1360
1410    IF SCLASS$ <> "S" THEN GOTO 1480
1420    IF CLAS$="CLERIC    " AND CVI(SDAM$) = 1 THEN GOTO 1450
1430    IF CVI(SDAM$) <> 3 THEN PRINT "YOU CAN'T USE THIS SPELL": GOTO 1360
1440    IF CLAS$="ELF       " OR CLAS$="MAGIC-USER" THEN GOTO 1450                        ELSE PRINT "YOU CAN'T USE THIS SPELL": GOTO 1360
1450    IF CVI(SWT$) > CVI(LVL$) THEN PRINT "YOU CAN'T USE THIS SPELL":                   GOTO 1360
1460    MAX.SPELLS = (CVI(LVL$)-CVI(SWT$))+1
1470    IF (QUAN-VAL(REPLY$)) > MAX.SPELLS THEN PRINT "YOU MUST SELL ";(QUAN-MAX.SPELLS):                  GOTO 1360
1480    IF REPLY$ = " " THEN GOTO 1200
1490    LET SQUAN = VAL(REPLY$)
1500    IF SQUAN = 0 THEN GOTO 1200
1510    PRICE = SQUAN * CVI(SCOST$)
1520    IF SQUAN > QUAN THEN PRINT "YOU DON'T HAVE ";SQUAN: GOTO 1370
1530    LSET MONEY$ = MKS$(CVS(MONEY$) + PRICE)
1540    QUAN = QUAN - SQUAN
1550    ON RNO GOTO 1560,1570,1580,1590,1600,1610,1620,1630,1640,1650
1560    LSET P1$ = MKI$(QUAN): GOTO 1660
1570     LSET P2$ = MKI$(QUAN): GOTO 1660
1580     LSET P3$ = MKI$(QUAN): GOTO 1660
1590     LSET P4$ = MKI$(QUAN): GOTO 1660
1600     LSET P5$ = MKI$(QUAN): GOTO 1660
1610     LSET P6$ = MKI$(QUAN): GOTO 1660
1620     LSET P7$ = MKI$(QUAN): GOTO 1660
1630     LSET P8$ = MKI$(QUAN): GOTO 1660
1640     LSET P9$ = MKI$(QUAN): GOTO 1660
1650     LSET P10$ = MKI$(QUAN): GOTO 1660
1660    PUT #2,SNO
1670    GOTO 1200
1680 'END OF FILE
1690    PRINT "YOU HAVE";CVS(MONEY$);"GOLD PIECES"
1700    SV.TIMER!=TIMER+2
1710    IF TIMER < SV.TIMER! GOTO 1710
1720    PUT #1,RNO
1730 RETURN
1740 'ADD A NEW ITEM
1750    CLS: PRINT "          ADD A NEW ITEM"
1760    LOCATE 25,1: PRINT "ENTER END TO QUIT";: LOCATE 2,1
1770    PRINT
1780    PRINT
1790    PRINT "ENTER NAME OF ITEM"
1800    LOCATE 5,1: PRINT "..............."
1810    LOCATE 5,1
1820    INPUT "",WNAME$
1830    IF WNAME$ = "END" THEN GOTO 2210
1840    INPUT "ENTER COST (IN GOLD PIECES) ",WCOST
1850    PRINT "ENTER TYPE  A=ARMOR, W=WEAPON"
1860    PRINT "      E=EQUIPMENT, S=SPELL"
1870    INPUT WCLASS$
1880    IF WCLASS$ <> "A" AND WCLASS$ <> "W" AND WCLASS$ <> "E" AND                       WCLASS$ <> "S" THEN PRINT "YOU MUST ENTER A-W-E-S": GOTO 1850
1890    IF WCLASS$ = "A" THEN INPUT "ENTER ARMOR CLASS ",WDAM
1900    IF WCLASS$ = "W" THEN INPUT "ENTER DAMAGE POINTS ",WDAM
1910    IF WCLASS$ <> "S" THEN GOTO 1950
1920    PRINT "ENTER PLAYER CLASS "
1930    PRINT "1=CLERIC 3=ELF & MAGIC-USER"
1940    INPUT WDAM
1950    IF WCLASS$ <> "S" THEN INPUT "ENTER WEIGHT (IN GOLD PIECES) ",WWT                  ELSE INPUT "ENTER LEVEL ",WWT
1960    PRINT "IS THE ABOVE OK?"
1970    GOSUB 440
1980    IF REPLY$ <> "Y" THEN GOTO 1740
1990 'FIND END OF FILE
2000    SNO = SNO+1
2010    GET #2,SNO
2020    IF SID$ = "DS" THEN GOTO 1990
2030    LSET SID$ = "DS"
2040    LSET SCLASS$ = WCLASS$
2050    LSET SNAME$ = WNAME$
2060    LSET SCOST$ = MKI$(WCOST)
2070    LSET SDAM$ = MKI$(WDAM)
2080    LSET SWT$ = MKI$(WWT)
2090    LSET P1$ = MKI$(0)
2100    LSET P2$ = MKI$(0)
2110    LSET P3$ = MKI$(0)
2120    LSET P4$ = MKI$(0)
2130    LSET P5$ = MKI$(0)
2140    LSET P6$ = MKI$(0)
2150    LSET P7$ = MKI$(0)
2160    LSET P8$ = MKI$(0)
2170    LSET P9$ = MKI$(0)
2180    LSET P10$ = MKI$(0)
2190    PUT #2,SNO
2200    GOTO 1740
2210  RETURN
2220 'END
2230    CLS
2240    CLOSE
2250    CHAIN "MENU",1000
2260 'GET PLAYER
2270    CLS
2280    PRINT "ENTER YOUR PLAYER NUMBER "
2290    GOSUB 440: RNO=VAL(REPLY$)
2300    IF RNO < 1 OR RNO > 9 THEN PRINT "ENTER A NUMBER FROM 1 TO 9 ": GOTO 2280
2310    GET #1,RNO
2320    IF NM$ = SPACE$(24) THEN PRINT "THAT NUMBER IS NOT VALID": GOTO 2280
2330    PRINT "YOUR ARE ";NM$;"?"
2340    PRINT "Yes/No"
2350    GOSUB 440
2360    IF REPLY$ <> "Y" THEN GOTO 2260
2370 RETURN
2380 'CHANGE AN ITEM
2390    CLS
2400    PRINT "         CHANGE AN ITEM"
2410    PRINT
2420    PRINT "ENTER NAME OF ITEM (ENTER E TO END)"
2430    INPUT WNAME$
2440    IF WNAME$ = "E" THEN GOTO 2770 'END
2450    SKNM$=SPACE$(15)
2460    LSET SKNM$=WNAME$
2470    SNO=0
2480 'LOOK FOR ITEM
2490    SNO=SNO+1
2500    GET #2,SNO
2510    IF SID$ = "DS" THEN GOTO 2550
2520    PRINT SKNM$;" NOT FOUND"
2530    FOR X=1 TO 500: NEXT X 'KILL TIME
2540    GOTO 2380
2550    IF SNAME$ <> SKNM$ THEN GOTO 2480
2560    PRINT "1. ITEM ";SNAME$
2570    PRINT "2. CLASS ";SCLASS$
2580    PRINT "3. PRICE ";CVI(SCOST$)
2590    IF SCLASS$ = "W" THEN PRINT "4. DAMAGE ";CVI(SDAM$)
2600    IF SCLASS$ = "A" THEN PRINT "4. ARMOR CLASS ";CVI(SDAM$)
2610    IF SCLASS$ = "S" THEN PRINT "4. CHARACTER  ";CVI(SDAM$)
2620    IF SCLASS$ = "S" THEN PRINT "5. LEVEL "                                             ELSE PRINT "5. WEIGHT ";CVI(SWT$)
2630    PRINT "ENTER NUMBER OF FIELD TO CHANGE"
2640    INPUT CFLD
2650    IF CFLD=1 THEN INPUT "ENTER NEW NAME ";WNAME$: LSET SNAME$=WNAME$:                GOTO 2750
2660    IF CFLD=3 THEN INPUT "ENTER NEW PRICE ";WCOST: LSET SCOST$=MKI$(WCOST):           GOTO 2750
2670    IF CFLD=4 THEN INPUT "ENTER NEW DAMAGE/ARM CLASS/CHAR ";WDAM: LSET SDAM$=MKI$(WDAM):           GOTO 2750
2680    IF CFLD=5 THEN INPUT "ENTER NEW WEIGHT/LVL ";WWT: LSET SWT$=MKI$(WWT):               GOTO 2750
2690    IF CFLD <> 2 THEN GOTO 2560
2700    PRINT "ENTER TYPE  A=ARMOR, W=WEAPON"
2710    PRINT "      E=EQUIPMENT, S=SPELL"
2720    INPUT WCLASS$
2730    IF WCLASS$ <> "A" AND WCLASS$ <> "W" AND WCLASS$ <> "E" AND                       WCLASS$ <> "E" THEN PRINT "YOU MUST ENTER A-W-E-S": GOTO 2720
2740    LSET SCLASS$=WCLASS$
2750    PUT #2,SNO
2760    GOTO 2380
2770 RETURN
2780 'LIST SUPPLIES
2790    LPRINT "          THE SUPPLY SHOP  ";DATE$
2800    LPRINT: LPRINT
2810    LPRINT "CLASS","PRICE","DAM/AC/LVL","WEIGHT"
2820    SNO=0
2830 'LIST ITEMS
2840    SNO=SNO+1
2850    GET #2,SNO
2860    IF SID$ <> "DS" THEN GOTO 2910
2870    MSG$=STR$(SNO)+" "+SNAME$
2880    LPRINT MSG$
2890    LPRINT SCLASS$,CVI(SCOST$),CVI(SDAM$),CVI(SWT$)
2900    GOTO 2830
2910 RETURN